perm filename SAITRG.FAI[SYS,BGB]1 blob
sn#001411 filedate 1972-03-06 generic text, type T, neo UTF8
00100 TITLE TRIG
00200 INTERN SIN,COS,SIND,COSD,ASIN,ACOS,SQRT,ATAN,ATAN2
00300
00400 BEGIN SIN
00500 ;FLOATING POINT SINGLE PRECISION SINE AND COSINE FUNCTION
00600 ;IF THE ARGUMENT IS IN DEGREES, THE PROPER ENTRY POINTS ARE
00700 ;SIND AND COSD, WHILE IF THE ARGUMENT IS IN RADIANS, THE PROPER
00800 ;ENTRY POINTS ARE SIN AND COS.
00900 ;COSD CALLS SIND TO CALCULATE SIND(PI/2 + X)
01000 ;COS CALLS SIN TO CALCULATE SIN(PI/2 + X)
01100 ;SIND CALLS SIN AFTER A CONVERSION FROM DEGREES TO RADIANS
01200
01300 ;THE ROUTINE CALCULATES SINES AFTER REDUCING THE ARGUMENT TO
01400 ;THE FIRST QUADRANT AND CHECKING THE OVERFLOW BITS TO DETERMINE
01500 ;THE QUADRANT OF THE ORIGINAL ARGUMENT
01600 ;000 - 1ST QUADRANT
01700 ;001 - 2ND QUADRANT, X=-(X-PI)
01800 ;010 - 3RD QUADRANT, X=-(X-PI)
01900 ;011 - 4TH QUADRANT, X=X-3*PI/2-PI/2
02000 ;THE ALGORITHM USES A MODIFIED TAYLOR SERIES TO CALCULATE
02100 ;THE SINE OF THE NORMALIZED ARGUMENT.
02200 A← 1
02300 B← 2
02400 C← 3
02500 P← 17
00100 ↑COSD: ;ENTRY TO COSINE DEGREES ROUTINE
00200 MOVE A, -1(P) ;PICK UP THE ARGUMENT IN B
00300 FADR A, [90.0] ;ADD 90 DEGREES
00400 FDVR A, SCD1 ;CONVERT TO RADIANS
00500 JRST S1 ;ENTER SINE ROUTINE
00600 ↑SIND: ;ENTRY TO SINE DEGREES ROUTINE
00700 MOVE A, -1(P) ;PICK UP THE ARGUMENT IN B
00800 FDVR A, SCD1 ;CONVERT FROM DEGREES TO RADIANS
00900 JRST S1 ;ENTER SINE ROUTINE
01000 ↑COS: ;ENTRY TO COSINE RADIANS ROUTINE
01100 MOVE A, -1(P) ;PICK UP THE ARGUMENT IN B
01200 FADR A, PIOT ;ADD PI/2
01300 JRST S1 ;ENTER THE SINE ROUTINE
01400 ↑SIN: ;ENTRY TO SINE RADIANS ROUTINE
01500 MOVE A, -1(P) ;PICK UP THE ARGUMENT IN A
01600 S1: MOVM B,A ;GET ABSF OF ARGUMENT
01700 CAMG B, SP2 ;SINX = X IF X<2↑-10
01800 JRST SUBEXIT
01900 FDV B, PIOT ;DIVIDE X BY PI/2
02000 CAMG B, [1.0] ;IS X/(PI/2) < 1.0?
02100 JRST S2 ;YES, ARG IN 1ST QUADRANT ALREADY
02200 MULI B, 400 ;NO, SEPARATE FRACTION AND EXP.
02300 ASH C, -202(B) ;GET X MODULO 2PI
02400 MOVEI B, 200 ;PREPARE FLOATING FRACTION
02500 ROT C, 3 ;SAVE 3 BITS TO DETERMINE QUADRANT
02600 LSHC B, 33 ;ARGUMENT NOW IN RANGE (-1,1)
02700 FAD B, [0] ;NORMALIZE THE ARGUMENT
02800 JUMPE C, S2 ;REDUCED TO FIRST QUAD IF BITS 00
02900 TLCE C, 1000 ;SUBTRACT 1.0 FROM ARG IF BITS ARE
03000 FSB B, [1.0] ;01 OR 11
03100 TLCE C, 3000 ;CHECK FOR FIRST QUADRANT, 01
03200 TLNN C, 3000 ;CHECK FOR THIRD QUADRANT, 10
03300 MOVNS B ;01,10
00100 S2: SKIPGE A ;CHECK SIGN OF ORIGINAL ARG
00200 MOVNS B ;SIN(-X) = -SIN(X)
00300 MOVEM B, C ;STORE REDUCED ARGUMENT
00400 FMPR B, B ;CALCULATE X↑2
00500 MOVE A, SC9 ;GET FIRST CONSTANT
00600 FMP A, B ;MULTIPLY BY X↑2
00700 FAD A, SC7 ;ADD IN NEXT CONSTANT
00800 FMP A, B ;MULTIPLY BY X↑2
00900 FAD A, SC5 ;ADD IN NEXT CONSTANT
01000 FMP A, B ;MULTIPLY BY X↑2
01100 FAD A, SC3 ;ADD IN NEXT CONSTANT
01200 FMP A, B ;MULTIPLY BY X↑2
01300 FAD A, PIOT ;ADD IN LAST CONSTANT
01400 S2B: FMPR A, C ;MULTIPLY BY X
01500 JRST SUBEXIT
01600 SC3: 577265210372 ;-0.64596371106
01700 SC5: 175506321276 ;0.07968967928
01800 SC7: 606315546346 ;0.00467376557
01900 SC9: 164475536722 ;0.00015148419
02000 SP2: 170000000000 ;2**-10
02100 SCD1: 206712273406
02200 PIOT: 201622077325 ;PI/2
02300 BEND ;SINE
00100 BEGIN ASIN
00200 ;FLOATING POINT SINGLE PRECISION ARCSINE FUNCTION
00300 ;THE ARCSINE IS CALCULATED WITH THE FOLLOWING ALGORITHM:
00400 ; ASIN(X) = ATAN(X/SQRT(1-X↑2))
00500 ;THE RANGE OF DEFINITION FOR ASIN IS (-1.0,1.0)
00600 ;OTHER ARGUMENTS WILL GENERATE MEANINGLESS RESULTS
00700 A← 1
00800 B← 2
00900 P← 17
01000 ↑ASIN: ;ENTRY TO ASIN ROUTINE
01100 MOVN A, -1(P) ;SAVE THE NEGATIVE OF ARG
01200 FMP A, -1(P) ;CALCULATE -(X↑2)
01300 FAD A, [1.0] ;CALCULATE 1-(X↑2)
01400 JUMPE A, ASIN1 ;WAS X EITHER -1.0 OR 1.0?
01500 PUSH P, A ;NO, CALCULATE SQRT(1-X↑2)
01600 PUSHJ P, SQRT ;ADDRESS OF ARGUMENT OF SQRT
01700 MOVE B, -1(P) ;GET THE ARGUMENT BACK AGAIN
01800 FDVM B, A ;CALCULATE X/SQRT(1-X↑2)
01900 PUSH P, A ;CALCULATE ATAN(SQRT(1-X↑2))
02000 PUSHJ P, ATAN ;ADDRESS FOR ATAN ROUTINE
02100 JRST SUBEXIT
02200 ASIN1: MOVE A, PIOT ;ANSWER IS EITHER PI/2 OR-PI/2
02300 SKIPGE -1(P) ;WAS ORIGINAL ARGUMENT POSITIVE?
02400 MOVNS A ;NO, GET -PI/2
02500 JRST SUBEXIT
02600 PIOT: 201622077325 ;PI/2
02700 BEND ;ASIN
00100 BEGIN ACOS
00200 ;FLOATING POINT SINGLE PRECISION ARC-COSINE FUNCTION
00300 ;ACOS(X) IS CALCULATED AS
00400 ; ACOS(X)=(PI)/2 - ASIN(X)
00500 ;THE RANGE OF DEFINITION FOR ACOS IS (-1.0,1.0)
00600 ;ANY OTHER ARGUMENT WILL PRODUCE AN UNDEFINED ANSWER
00700 A← 1
00800 P← 17
00900 ↑ACOS: ;ENTRY TO SUBROUTINE
01000 MOVE A, -1(P) ;GET ARGUMENT IN A
01100 PUSH P, A ;CALL ASIN ROUTINE
01200 PUSHJ P, ASIN ;ADDRESS OF ARGUMENT
01300 MOVNS A ;GET -(ASIN(X))
01400 FAD A, PIOT ;CALCULATE (PI/2)-ASIN(X)
01500 JRST SUBEXIT
01600 PIOT: 201622077325
01700 BEND ;ACOS
00100 BEGIN SQRT
00200 ;FLOATING POINT SINGLE PRECISION SQUARE ROOT FUNCTION
00300 ;THE SQUARE ROOT OF THE ABSOLUTE VALUE OF THE ARGUMENT IS
00400 ;CALCULATED. THE ARGUMENT IS WRITTEN IN THE FORM
00500 ; X= F*(2**2B) WHERE 0<F<1
00600 ;SQRT(X) IS THEN CALCULATED AS (SQRT(X))*(2**B)
00700 ;SQRT(F) IS CALCULATED BY A LINEAR APPROXIMATION, THE NATURE
00800 ;OF WHICH DEPENDS ON WHETHER 1/4 < F < 1/2 OR 1/2 < F < 1,
00900 ;FOLLOWED BY TWO ITERATIONS OF NEWTON'S METHOD.
01000 A← 1
01100 B← 2
01200 C← 3
01300 D← 4
01400 P← 17
01500 ↑SQRT: ;ENTRY TO SQUARE ROOT ROUTINE
01600 MOVE B,-1(P) ;PICK UP THE ARGUMENT IN B
01700 SQRT1: JUMPLE B,[SETZ A, ↔ JRST SUBEXIT]
01800 ASHC B, -33 ;PUT EXPONENT IN B, FRACTION IN C
01900 SUBI B, 201 ;SUBTRACT 201 FROM EXPONENT
02000 ROT B, -1 ;CUT EXP IN HALF, SAVE ODD BIT
02100 HRRZM B, D ;SAVE FOR FUTURE SCALING OF ANS
02200 LSH B, -43 ;GET BIT SAVED BY PREVIOUS INST.
02300 ASH C, -10 ;PUT FRACTION IN PROPER POSITION
02400 FSC C, 177(B) ;PUT EXPONENT OF FRACT TO -1 OR 0
02500 MOVEM C, A ;SAVE IT. 1/4 < F < 1
02600 FMP C, S1(B) ;LINEAR FIRST APPROX,DEPENDS ON
02700 FAD C, S2(B) ;WHETHER 1/4<F<1/2 OR 1/2<F<1.
02800 MOVE B, A ;START NEWTONS METHOD WITH FRAC
02900 FDV B, C ;CALCULATE X(0)/X(1)
03000 FAD C, B ;X(1) + X(0)/X(1)
03100 FSC C, -1 ;1/2(X(1) + X(0)/X(1))
03200 FDV A, C ;X(0)/X(2)
03300 FADR A, C ;X(2) + X(0)/X(2)
03400 FSC A,@D ;SCALE ANSWER FOR NEWTON AND EXP
03500 ↑SUBEXIT: SUB P,[XWD 2,2]
03600 JRST @2(P) ;EXIT
03700 S1: 0.8125 ;CONSTANT, USED IF 1/4<FRAC<1/2
03800 0.578125 ;CONSTANT, USED IF 1/2<FRAC<1
03900 S2: 0.302734 ;CONSTANT, USED IF 1/4<FRAC<1/2
04000 0.421875 ;CONSTANT, USED IF 1/2<FRAC<1
04100 BEND ; SQRT
00100 BEGIN ATAN
00200 ;FLOATING POINT SINGLE PRECISION ARCTANGENT FUNCTION
00300 ;ATAN(X) = X(B0+A1(Z+B1-A2(Z+B2-A3(Z+B3)**-1)**-1)**-1)
00400 ;WHERE Z=X↑2, IF 0<X<=1
00500 ;IF X>1, THEN ATAN(X) = PI/2 - ATAN(1/X)
00600 ;IF X>1, THEN RH(D) =-1, AND LH(D) = -SGN(X)
00700 ;IF X<1, THEN RH(D) = 0, AND LH(D) = SGN(X)
00800 A← 1
00900 B← 2
01000 C← 3
01100 D← 4
01200 E← 5
01300 P← 17
00100 ↑ATAN: ;ENTRY TO ARCTANGENT ROUTINE
00200 MOVE A,-1(P) ;PICK UP THE ARGUMENT IN A
00300 ATAN1: MOVM B, A ;GET ABSF OF ARGUMENT
00400 CAMG B, A1 ;IF X<2↑-33, THEN RETURN WITH...
00500 JRST SUBEXIT ;ATAN(X) = X
00600 HLLO D, A ;SAVE SIGN, SET RH(D) = -1
00700 CAML B, A2 ;IF A>2↑33, THEN RETURN WITH
00800 JRST [MOVE A,PIOT ↔ JRST SUBEXIT]; ATAN(X) = PI/2
00900 MOVSI C, 201400 ;FORM 1.0 IN C
01000 CAMG B, C ;IS ABSF(X)>1.0?
01100 TRZA D, -1 ;IF B .LE. 1.0, THEN RH(D) = 0
01200 FDVM C, B ;B IS REPLACED BY 1.0/B
01300 TLC D, (D) ;XOR SIGN WITH .G. 1.0 INDICATOR
01400 MOVEM B, E ;SAVE THE ARGUMENT
01500 FMP B, B ;GET B↑2
01600 MOVE C, KB3 ;PICK UP A CONSTANT
01700 FAD C, B ;ADD B↑2
01800 MOVE A, KA3 ;ADD IN NEXT CONSTANT
01900 FDVM A, C ;FORM -A3/(B↑2 + B3)
02000 FAD C, B ;ADD B↑2 TO PARTIAL SUM
02100 FAD C, KB2 ;ADD B2 TO PARTIAL SUM
02200 MOVE A, KA2 ;PICK UP -A2
02300 FDVM A, C ;DIVIDE PARTIAL SUM BY -A2
02400 FAD C, B ;ADD B↑2 TO PARTIAL SUM
02500 FAD C, KB1 ;ADD B1 TO PARTIAL SUM
02600 MOVE A, KA1 ;PICK UP A1
02700 FDV A, C ;DIVIDE PARTIAL SUM BY A1
02800 FAD A, KB0 ;ADD B0
02900 FMP A, E ;MULTIPLY BY ORIGINAL ARGUMENT
03000 TRNE D, -1 ;CHECK .G. 1.0 INDICATOR
03100 FSB A, PIOT ;ATAN(A) = -(ATAN(1/A)-PI/2)
03200 SKIPGE D ;LH(D) = -SGN(B) IF B>1.0
03300 MOVNS A ;NEGATE ANSWER
03400 JRST SUBEXIT ;EXIT
03500 A1: 145000000000 ;2**-33
03600 A2: 233000000000 ;2**33
03700 KB0: 176545543401 ;0.1746554388
03800 KB1: 203660615617 ;6.762139240
03900 KB2: 202650373270 ;3.316335425
04000 KB3: 201562663021 ;1.448631538
04100 KA1: 202732621643 ;3.709256262
04200 KA2: 574071125540 ;-7.106760045
04300 KA3: 600360700773 ;-0.2647686202
04400 PIOT: 201622077325 ;PI/2
04500 BEND ;ATAN
00100 BEGIN ATAN2
00200 ;FLOATING POINT ARCTANGENT OF TWO ARGUMENTS
00300 ;RETURNS ARCTANGENT OF A/B
00400 ;THERE IS NO RESTRICTION ON THE ARGUMENTS
00500 ;THE ANSWER IS RETURNED IN ACCUMULATOR A.
00600 A← 1
00700 B← 2
00800 P← 17
00900 ↑ATAN2: ;ENTRY POINT TO ATAN2 ROUTINE
01000 MOVM A,-2(P)
01100 MOVM B,-1(P)
01200 CAML A,B
01300 JRST FOO
01400 MOVE A, -2(P) ;PICK UP FIRST ARGUMENT
01500 FDVR A, -1(P) ;FORM A/B
01600 PUSH P, A ;CALCULATE ATAN (A/B)
01700 PUSHJ P, ATAN
01800 SKIPL -1(P) ;IF B>0, SGN(ATAN2)=SGN(A)
01900 JRST EXIT2 ;EXIT
02000 JUMPGE A, ATAN2A ;IS A POSITIVE?
02100 FADR A, PI. ;NO, SECOND QUADRANT, ADD PI
02200 JRST EXIT2 ;EXIT
02300 ATAN2A: FSB A, PI. ;YES,3RD QUADRANT, SUBTRACT PI
02400 JRST EXIT2 ;EXIT
02500 FOO: MOVN A,-1(P)
02600 FDVR A,-2(P)
02700 PUSH P,A
02800 PUSHJ P,ATAN
02900 SKIPG -2(P)
03000 JRST XYZ
03100 FADR A,PI2
03200 JRST EXIT2
03300 XYZ: FSB A,PI2
03400 EXIT2: SUB P,[XWD 3,3]
03500 JRST @3(P)
03600 PI.: 202622077325
03700 PI2: 201622077325
03800 BEND ;ATAN2
03900 END